home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 376-400 / disk_386 / xlispstat / src1.lzh / XLisp / xlio.c < prev    next >
C/C++ Source or Header  |  1990-10-03  |  5KB  |  224 lines
  1. /* xlio - xlisp i/o routines */
  2. /* Copyright (c) 1989, by David Michael Betz.                            */
  3. /* You may give out copies of this software; for conditions see the file */
  4. /* COPYING included with this distribution.                              */
  5.  
  6. #include "xlisp.h"
  7. #include "osdef.h"
  8. #ifdef ANSI
  9. #include "xlproto.h"
  10. #include "osproto.h"
  11. #else
  12. #include "xlfun.h"
  13. #include "osfun.h"
  14. #endif ANSI
  15. #include "xlvar.h"
  16.  
  17. /* xlgetc - get a character from a file or stream */
  18. int xlgetc(fptr)
  19.   LVAL fptr;
  20. {
  21.     LVAL lptr,cptr;
  22.     FILE *fp;
  23.     int ch;
  24.  
  25.     /* check for input from nil */
  26.     if (fptr == NIL)
  27.     ch = EOF;
  28.  
  29.     /* otherwise, check for input from a stream */
  30.     else if (ustreamp(fptr)) {
  31.     if ((lptr = gethead(fptr)) == NIL)
  32.         ch = EOF;
  33.     else {
  34.         if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr)){
  35.           if (!consp(lptr)) xlerror("not a cons in stream", lptr);
  36.           if (cptr == NIL) xlfail("character is nil in stream");
  37.           if (!charp(cptr)) xlerror("not a character in stream", cptr);
  38.         xlfail("bad stream");
  39.         }
  40.         sethead(fptr,lptr = cdr(lptr));
  41.         if (lptr == NIL)
  42.         settail(fptr,NIL);
  43.         ch = getchcode(cptr);
  44.     }
  45.     }
  46.  
  47.     /* otherwise, check for a buffered character */
  48.     else if (ch = getsavech(fptr))
  49.     setsavech(fptr,'\0');
  50.  
  51.     /* otherwise, check for terminal input or file input */
  52.     else {
  53.     fp = getfile(fptr);
  54.     if (fp == stdin || fp == stderr)
  55.         ch = ostgetc();
  56.     else
  57.         ch = osagetc(fp);
  58.     }
  59.  
  60.     /* return the character */
  61.     return (ch);
  62. }
  63.  
  64. /* xlungetc - unget a character */
  65. void xlungetc(fptr,ch)
  66.   LVAL fptr; int ch;
  67. {
  68.     LVAL lptr;
  69.     
  70.     /* check for ungetc from nil */
  71.     if (fptr == NIL)
  72.     ;
  73.     
  74.     /* otherwise, check for ungetc to a stream */
  75.     if (ustreamp(fptr)) {
  76.     if (ch != EOF) {
  77.         lptr = cons(cvchar(ch),gethead(fptr));
  78.         if (gethead(fptr) == NIL)
  79.         settail(fptr,lptr);
  80.         sethead(fptr,lptr);
  81.     }
  82.     }
  83.     
  84.     /* otherwise, it must be a file */
  85.     else
  86.     setsavech(fptr,ch);
  87. }
  88.  
  89. /* xlpeek - peek at a character from a file or stream */
  90. int xlpeek(fptr)
  91.   LVAL fptr;
  92. {
  93.     LVAL lptr,cptr;
  94.     int ch;
  95.  
  96.     /* check for input from nil */
  97.     if (fptr == NIL)
  98.     ch = EOF;
  99.  
  100.     /* otherwise, check for input from a stream */
  101.     else if (ustreamp(fptr)) {
  102.     if ((lptr = gethead(fptr)) == NIL)
  103.         ch = EOF;
  104.     else {
  105.         if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
  106.         xlfail("bad stream");
  107.         ch = getchcode(cptr);
  108.     }
  109.     }
  110.  
  111.     /* otherwise, get the next file character and save it */
  112.     else {
  113.     ch = xlgetc(fptr);
  114.     setsavech(fptr,ch);
  115.     }
  116.  
  117.     /* return the character */
  118.     return (ch);
  119. }
  120.  
  121. /* xlputc - put a character to a file or stream */
  122. void xlputc(fptr,ch)
  123.   LVAL fptr; int ch;
  124. {
  125.     LVAL lptr;
  126.     FILE *fp;
  127.  
  128.     /* count the character */
  129.     ++xlfsize;
  130.  
  131.     /* check for output to nil */
  132.     if (fptr == NIL)
  133.     ;
  134.  
  135.     /* otherwise, check for output to an unnamed stream */
  136.     else if (ustreamp(fptr)) {
  137.         LVAL chp;
  138.         xlsave1(chp);
  139.         chp = cvchar(ch);
  140.     lptr = consa(chp);
  141.     if (gettail(fptr))
  142.         rplacd(gettail(fptr),lptr);
  143.     else
  144.         sethead(fptr,lptr);
  145.     settail(fptr,lptr);
  146.     xlpop();
  147.     }
  148.  
  149.     /* otherwise, check for terminal output or file output */
  150.     else {
  151.     fp = getfile(fptr);
  152.     if (fp == stdout || fp == stderr)
  153.         ostputc(ch);
  154.     else
  155.         osaputc(ch,fp);
  156.     }
  157. }
  158.  
  159. /* xlflush - flush the input buffer */
  160. int xlflush()
  161. {
  162.     osflush();
  163.     return(0);  /* to keep compilers happy - L. Tierney */
  164. }
  165.  
  166. /* stdprint - print to *standard-output* */
  167. void stdprint(expr)
  168.   LVAL expr;
  169. {
  170.     xlprint(getvalue(s_stdout),expr,TRUE);
  171.     xlterpri(getvalue(s_stdout));
  172. }
  173.  
  174. /* stdputstr - print a string to *standard-output* */
  175. void stdputstr(str)
  176.   char *str;
  177. {
  178.     xlputstr(getvalue(s_stdout),str);
  179. }
  180.  
  181. /* errprint - print to *error-output* */
  182. void errprint(expr)
  183.   LVAL expr;
  184. {
  185.     xlprint(getvalue(s_stderr),expr,TRUE);
  186.     xlterpri(getvalue(s_stderr));
  187. }
  188.  
  189. /* errputstr - print a string to *error-output* */
  190. void errputstr(str)
  191.   char *str;
  192. {
  193.     xlputstr(getvalue(s_stderr),str);
  194. }
  195.  
  196. /* dbgprint - print to *debug-io* */
  197. void dbgprint(expr)
  198.   LVAL expr;
  199. {
  200.     xlprint(getvalue(s_debugio),expr,TRUE);
  201.     xlterpri(getvalue(s_debugio));
  202. }
  203.  
  204. /* dbgputstr - print a string to *debug-io* */
  205. void dbgputstr(str)
  206.   char *str;
  207. {
  208.     xlputstr(getvalue(s_debugio),str);
  209. }
  210.  
  211. /* trcprin1 - print to *trace-output* */
  212. void trcprin1(expr)
  213.   LVAL expr;
  214. {
  215.     xlprint(getvalue(s_traceout),expr,TRUE);
  216. }
  217.  
  218. /* trcputstr - print a string to *trace-output* */
  219. void trcputstr(str)
  220.   char *str;
  221. {
  222.     xlputstr(getvalue(s_traceout),str);
  223. }
  224.